{________________________________________________}
{PAINTFILEMGR  Unit                                                                  }
{                                                                                                }
{	Procedures for opening and displaying Paint files with           }
{	high level routines from Toolbox file manager.  This might     }
{	not work in a 128K Mac, but could probably be made to work }
{	by reading and unpacking the file in smaller chunks.                }
{	                                                                                             }
{AUTHOR                                                                                     }
{	Gary B. Palmer.  Public domain. October 25, 1986.                 }
{	Author reserves right to use in own programs.                       }
{________________________________________________}
UNIT PaintFileMgr;

INTERFACE

	PROCEDURE GetPaintImage (VAR ImagePtr : Ptr);
	PROCEDURE DisplayPaintFile (ImagePtr : Ptr);

IMPLEMENTATION

{--------- Internal routines --------}

	PROCEDURE doMessage (mes0 : str255;
									mes1 : str255;
									mes2 : str255;
									mes3 : str255);
		CONST
			MessageDialog = 258;
		VAR
			dialogP : DialogPtr;
			item : integer;
			dlogRect : rect;
	BEGIN
		ParamText(mes0, mes1, mes2, mes3);
		SetRect(dlogRect, 100, 100, 400, 200);
		dialogP := GetNewDialog(MessageDialog, NIL, pointer(-1));
		IF dialogP = NIL THEN
			BEGIN
				SysBeep(5);
				ExitToShell;
			END;
		initCursor;
		ModalDialog(NIL, item);
		DisposDialog(dialogP);
	END;

	PROCEDURE SFGetPaint (VAR theReply : SFReply);
		CONST
			SFPutLeft = 100;
			SFPutTop = 100;
		VAR
			SFPutPt : Point;
			PNTG_list : SFTypeList;
	BEGIN
		PNTG_list[0] := 'PNTG';
		SetPt(SFPutPt, SFPutLeft, SFPutTop);
		SFGetFile(SFPutPt, '', NIL, 1, PNTG_list, NIL, theReply);
	END;{SFGetPaint}

	PROCEDURE CloseOldFile (refNum : Integer;
									vRefNum : Integer);
		VAR
			err : OSErr;
	BEGIN
		err := FSClose(refNum);
		IF err <> noErr THEN
			BEGIN
				doMessage('FSClose error', 'CloseOldFile routine', 'Could not close file ', '');
			END;
		err := FlushVol(NIL, vRefNum);
		IF err <> noErr THEN
			BEGIN
				doMessage('FlushVol error', 'CloseOldFile routine', 'Could not Flush volume ', '');
			END;
	END;{CloseOldFile}

	PROCEDURE ReadPaintFile (refNum : Integer;
									VAR PackedBitsPtr : Ptr);
		LABEL
			1;
		VAR
			bytes : LongInt;
			str1 : str255;
			err : OSErr;
	BEGIN
		PackedBitsPtr := NIL;
		err := GetEOF(refNum, bytes);  {FIND LOGICAL END OF FILE}
		IF err <> noErr THEN
			BEGIN
				doMessage('GetEOF error', 'ReadPaintFile routine', 'Could not find file end', '');
			END;
		bytes := bytes - 512;			{HEADER BLOCK NOT NEEDED}
		IF odd(bytes) THEN
			BEGIN
				NumToString(bytes, str1);
				str1 := concat('Bytes - header = ', str1);
				doMessage('Logical EOF Odd', str1, 'Not a MacPaint File.', '');
		{goto 1;  try anyway!}
			END
		ELSE
			BEGIN
				NumToString(bytes, str1);
				str1 := concat('Bytes - header =', str1);
				doMessage('Reading Paint type...', str1, '', '');
			END;
		PackedBitsPtr := NewPtr(bytes);	{MAKE A HOME FOR THE DATA}
		IF MemError <> noErr THEN
			BEGIN
				PackedBitsPtr := NIL;
				doMessage('PackBitsPtr Memory err', 'ReadPaintFile routine', 'No room to read in data', '');
				GOTO 1;
			END;
		err := SetFPos(refNum, FSFromStart, 512); 	{START AT BEGINNING OF DATA}
		IF err <> noErr THEN
			BEGIN
				doMessage('SetFPos error', 'ReadPaintFile routine', 'Could not set file ', 'at start of data');
			END;
		err := FSRead(refNum, bytes, PackedBitsPtr);  {READ THE DATA TO THE BUFFER}
		IF err <> noErr THEN
			BEGIN
				doMessage('FSRead error', 'ReadPaintFile routine', 'Problem reading in file', '');
				GOTO 1;
			END;
1 :
	END;{ReadPaintFile}

	PROCEDURE GetPaintImage;{ (var ImagePtr : Ptr)}
		LABEL
			2;
		CONST
			SizeOfPaintImage = 51840;
		VAR
			refNum : Integer;
			theReply : SFReply;
			err : OSErr;
			packedBitsPtr : Ptr;
			destPtr, SrcPtr : Ptr;
			saveStart : longInt;
			bytesUnPacked : Integer;
	BEGIN
		ImagePtr := NIL;
		SFGetPaint(theReply);
		WITH theReply DO
			IF NOT good THEN
				GOTO 2
			ELSE
				BEGIN
					err := FSOpen(fName, vRefNum, refNum);
					IF err <> 0 THEN
						BEGIN
							doMessage('FSOpen error on file', 'GetPaintImage routine', 'Can not Open File ', '');
							GOTO 2;
						END;
					ReadPaintFile(refNum, packedBitsPtr);
			{RETURNS A POINTER TO THE PACKED DATA.  SEE ABOVE}
					CloseOldFile(refNum, vRefNum); 	{CLOSE FILE IMMEDIATELY}
					IF packedBitsPtr = NIL THEN
						BEGIN
							GOTO 2;
						END;
					ImagePtr := NewPtr(SizeOfPaintImage); {MAKE A HOME FOR THE IMAGE}
					IF MemError <> 0 THEN
						BEGIN
							doMessage('ImagePtr Memory err', 'GetPaintImage routine', 'No room for image', '');
							GOTO 2;
						END;

				{POINTERS TO BE USED BY UNPACKBITS WILL BE INCREMENTED, SO SAVE}
				{OLD POINTERS BY CREATING A COUPLE OF SCAPEGOATS:SRCPTR AND DESTPTR}
					SrcPtr := packedBitsPtr;	{SRCPTR WILL BE INCREMENTED}
					DestPtr := ImagePtr;	{DESTPTR WILL BE INCREMENTED}

				{A PAINT IMAGE HAS MORE BYTES THAN CAN BE REPRESENTED BY AN}
				{INTEGER, AND UNPACKBITS ACCEPTS ONLY INTEGERS, SO UNPACK}
				{ONLY HALF THE BYTES AT A TIME.}

					saveStart := ord(DestPtr);
					UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage DIV 2);
					bytesUnPacked := ord(DestPtr) - saveStart;

				{THE FINAL UNPACKING STARTS FROM THE NEW VALUES OF SRCPTR.}
					UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage - bytesUnPacked);
					DisposPtr(packedBitsPtr);
				END;
2 :
	END;{GetPaintImage}

	PROCEDURE DisplayPaintFile; {(ImagePtr : Ptr);}
		LABEL
			3;
		VAR
			pageBits : BitMap;
			drawRect : Rect;
			screen : Rect;
	BEGIN
		IF ImagePtr = NIL THEN
			BEGIN
				GOTO 3;
			END;

		{SET UP AN APPROPRIATE BITMAP TO SEND TO COPYBITS}
		WITH pageBits DO
			BEGIN
				baseAddr := ImagePtr; 	{GIVE THE BUFFER TO THE BITMAP}
				rowBytes := 72;			{ROWBYTES OF PAINT IMAGE}
				SetRect(bounds, 0, 0, 576, 720); 	{ENCLOSES PAINT IMAGE}
			END;

		{ASSUMES THE MAIN PROGRAM HAS OPENED A WINDOW APPROX}
		{THE SAME SIZE AS THE SCREEN AND SET THE PORT}
		screen := screenBits.bounds;
		setRect(drawRect, screen.left + 148, screen.top + 0, screen.right - 148, screen.bottom - 72); {3/8 image bounds size}
		copyBits(pageBits, thePort^.portbits, pagebits.bounds, drawRect, srcCopy, NIL);
3 :
	END;{DisplayPaintFile}

END.	{of unit}